HPAVC/HPAVC CD-ROM.iso/pc/MYMUD21.ZIP/MMUD21.ZIP/SOURCE/SOURCE.ZIP/MULTI.PAS

Pascal/Delphi Source File | 1995-01-21 | 13.4 KB | 609 lines

{$I COPYRGHT.INC}

(*---------------------------------------------------------------------------*
   This unit contains all the routines nessecary for the multiuser support
 *---------------------------------------------------------------------------*)

Unit Multi;
Interface
Uses Dos,
     MyIO,
     Misc,
     Header,
     Timer,
     BIN_DB,
     NewWorld,
     Out_Proc;

Const MaxMudNodes = 511;


Var LockLevel : Word;
    LockFile  : File;
    LockStats : LongInt;
    LockCalls : LongInt;
    DoubleCalls: LongInt;



Type NodeInfoRecord = Record
       Player       : Integer;
       Room         : Integer;
       Last         : LongInt;
       Note         : String[40];
     End;
     NodeListType   = Array[0..MaxMudNodes] Of NodeInfoRecord;

Var TempDir     : PathStr;
    Editor      : ComStr;
    TextPath    : ComStr;
    WorldPath   : ComStr;
    Mynode      : Integer;
    NodeList    : NodeListType;

Procedure ReadINI;

Procedure GrabNodeNr;
Procedure FreeNode;

Procedure UpdateNodeInfo(Current : ContextType);
Procedure GrabUserList;


Procedure NotifyAllHere(Name : String;T : TextRecord);
Procedure SayToAllHere(Current : ContextType;S : String);
Procedure GeneralRemarkToAllHere(S : String);
Procedure NotifyAll(T : TextRecord);
Procedure SayToAll(S : String);
Procedure SayPrivate(ObjNr : Integer;S : String);



Procedure ShutDownGame;
Function CheckShutDown:Boolean;

Function CheckResetMe:Boolean;
Procedure ResetPlayerObj(ObjNr : Integer);

Function CheckMail:Boolean;

Procedure ReadMail;
Function IsAlive(ObjNr : Integer):Boolean;

Procedure Lock(Reason : String);
Procedure UnLock;
Procedure ShowLockStat;

Type StatusTypes = (SetSem,DelSem,WaitSem);
     SemName     = String[8];

Procedure Semafore(Name : SemName;Status : StatusTypes);

Implementation

Procedure Semafore(Name : SemName;Status : StatusTypes);
Var Tmp     : file;
    TimeOut : TimerObject;
Begin
Case Status Of
 SetSem : Begin
          Assign(Tmp,TempDir+Name+'.SEM');
          Rewrite(Tmp);
          Close(Tmp);
          If IoResult<>0 Then;
          End;
 DelSem : Begin
          Assign(Tmp,TempDir+Name+'.SEM');
          Erase(Tmp);
          End;
 WaitSem: Begin
          TimeOut.SetTimer(50);
          Repeat
          Until (Not ExistFile(TempDir+Name+'.SEM')) Or TimeOut.TimeUp;
          If ExistFile(TempDir+Name+'.SEM')
             Then Semafore(Name,DelSem);
          End;
End; {Case}
End;

(*--------------------------------------------------------------------------*)
Procedure GrabNodeNr;
Var Search : SearchRec;
    Tmp    : File;
Begin
MyNode:=1;
FindFirst(TempDir+'InUse.'+Nr2Str(MyNode),AnyFile,Search);
While (DosError=0) And (MyNode<=MaxMudNodes) Do
 Begin
 Inc(MyNode);
 FindFirst(TempDir+'InUse.'+Nr2Str(MyNode),AnyFile,Search);
 End;

If MyNode>MaxMudNodes
   Then MyNode:=NOTHING
   Else Begin
        Assign(Tmp,TempDir+'InUse.'+Nr2Str(MyNode));
        Rewrite(Tmp);
        Close(Tmp);
        If IoResult<> 0 Then;
        End;
End;

(*--------------------------------------------------------------------------*)
Procedure FreeNode;
Var Tmp   : File;
    Count : Byte;
Begin
Count:=0;
Repeat
 Assign(Tmp,TempDir+'InUse.'+Nr2Str(MyNode));
 Erase(Tmp);
 If IoResult<>0
    Then Inc(Count);
Until (IoResult=0) Or (Count>3);
End;

(*--------------------------------------------------------------------------*)
Procedure ReadINI;
Var IniName : ComStr;
    Ini     : Text;
    Sem     : File;
    Count   : Byte;
    Tmp     : ContextType;
    P       : Byte;
    Ok      : Boolean;
Begin
ININame:=ParamStr(1);
If Pos('.',ININame)>0
   Then ININame:=Copy(ININame,1,Pos('.',ININame)-1);

If Not ExistFile(IniName+'.INI')
   Then Begin
        My_Write('Database not found. Create new database? [y/N]:');
        If Upcase(My_ReadKey)='Y'
           Then CreateNewWorld(IniName)
           Else Halt;
        End;

WorldPath:=IniName;
While (WorldPath<>'') And (Not (WorldPath[Length(WorldPath)] in ['\',':'])) Do
 Dec(WorldPath[0]);
CompletePath(WorldPath);

Count:=0;
Repeat
  Assign(INI,ININame+'.INI');
  Reset(INI);
  Ok:=IoResult=0;
  If Not Ok
     Then Begin
          Inc(Count);
          My_Delay(500);
          End;
Until Ok Or (Count>3);
If Count>3
   Then Halt(150);
ReadLn(Ini,TempDir);
ReadLn(Ini,Editor);
ReadLn(Ini,TextPath);
Close(Ini);
If IoResult<>0
   Then Halt(103);

P:=Pos('~',TempDir);
if P>0
   Then Begin
        Delete(TempDir,P,1);
        Insert(HomeDir,TempDir,P);
        End;

P:=Pos('~',TextPath);
if P>0
   Then Begin
        Delete(TextPath,P,1);
        Insert(HomeDir,TextPath,P);
        End;

Tmp.Player:=NOTHING;

CompletePath(TextPath);
If Not ExistFile(TextPath+'*.*')
   Then Begin
        My_WriteLn('TextDir doesn''t exist: '+TextPath);
        Halt(0);
        End;

CompletePath(TempDir);
If Not ExistFile(TempDir+'*.*')
   Then Begin
        My_WriteLn('TempDir doesn''t exist: '+TempDir);
        Halt(0);
        End;

If Not ExistFile(TempDir+'MUDLOCK.SEM')
   Then Begin
        Assign(Sem,TempDir+'MUDLOCK.SEM');
        Rewrite(Sem,1);
        Close(Sem);
        If IoResult<>0
           Then;
        End;

If Not ExistFile(Editor)
   Then Editor:='';

UpdateNodeInfo(Tmp);
End;

(*--------------------------------------------------------------------------*)
Procedure UpdateNodeInfo(Current : ContextType);
Var NodeInfo : NodeInfoRecord;
    Tmp      : File of NodeInfoRecord;
    D        : DateTime;
    Dum      : Word;
Begin
NodeInfo.Player:=Current.Player;
NodeInfo.Room:=Current.Room;
NodeInfo.Note:=Current.Note;

GetTime(D.Hour,D.Min,D.Sec,dum);
GetDate(D.Year,D.Month,D.Day,Dum);
PackTime(D,NodeInfo.Last);

Lock('Update node info');
FileMode:=ReadWrite+ShareDenyAll;
Assign(Tmp,TempDir+'NODEINFO.DAT');
Reset(Tmp);
If IoResult<>0
   Then Rewrite(Tmp);
Seek(Tmp,MyNode);
Write(Tmp,NodeInfo);
Close(Tmp);
If IoResult<>0
   Then;
UnLock;
End;


(*--------------------------------------------------------------------------*)
Procedure GrabUserList;
Var Tmp      : File;
    NodeInfo : NodeInfoRecord;
    RR       : Word;
Begin
Lock('Nodelist again');
FillChar(NodeList,SizeOf(NodeList),#00);
FileMode:=ReadOnly+ShareDenyNone;
Assign(Tmp,TempDir+'NODEINFO.DAT');
Reset(Tmp,1);
BlockRead(Tmp,NodeList,SizeOf(NodeList),RR);
Close(Tmp);
Unlock;

End;


(*--------------------------------------------------------------------------*)
Function IsAlive(ObjNr : Integer):Boolean;
Var C: Word;
Begin
GrabUserList;
C:=0;
While (C<=MaxMudNodes) And (ObjNr<>NodeList[C].Player) Do
 Inc(C);
IsAlive:=(C<MaxMudNodes) {And (C<>MyNode)};
End;

(*--------------------------------------------------------------------------*)
Procedure NotifyAllHere(Name : String;T : TextRecord);
Var out : File;
    Len : Word;
    C   : Word;
    RW  : Word;
    Tries : Word;
Begin
GrabUserList;


If T[0]=#00
   Then Exit;

Len:=0;
While T[Len]<>#00 Do
 Inc(Len);

If Name<>''
   Then Begin
        Move(T[0],T[Length(Name)],Len);
        Len:=Len+Length(Name);
        Move(Name[1],T[0],Length(Name));
        End;
Lock('Send message all here');
For C:=0 To MaxMudNodes Do
 Begin
 If (NodeList[C].Player>0) And (C<>MyNode) And
    (NodeList[C].Room=NodeList[MyNode].Room)
    Then Begin
         FileMode:=ReadWrite+ShareDenyAll;
         Assign(Out,TempDir+'Message.'+Nr2Str(C));
         Reset(Out,1);
         If IoResult<>0
            Then Rewrite(Out,1);
         Seek(Out,FileSize(Out));
         BlockWrite(Out,T,SizeOf(T),RW);
         Close(Out);
         If IoResult<>0
            Then;
         End;
 End;
Unlock;
End;


(*--------------------------------------------------------------------------*)
Procedure NotifyAll(T : TextRecord);
Var out : File;
    C   : Word;
    RW  : Word;

Begin
GrabUserList;


If T[0]=#00
   Then Exit;
Lock('Notify all everywhere');
For C:=0 To MaxMudNodes Do
 Begin
 If (NodeList[C].Player>0) And (C<>MyNode)
    Then Begin
         FileMode:=ReadWrite+ShareDenyAll;
         Assign(Out,TempDir+'Message.'+Nr2Str(C));
         Reset(Out,1);
         If IoResult<>0
            Then Rewrite(Out,1);
         Seek(Out,FileSizE(Out));
         BlockWrite(Out,T,SizeOf(T),RW);
         Close(Out);
         If IoResult<>0
            Then;
         End;
 End;
UnLock;
End;


(*--------------------------------------------------------------------------*)
Procedure PrivateMsg(ToPlayer : Word;T : TextRecord);
Var Out   : File;
    ToNode: Word;
    RW    : Word;

Begin
GrabUserList;

ToNode:=0;
While (ToNode<=MaxMudNodes) And (NodeList[ToNode].Player<>ToPlayer) Do
 Inc(ToNode);

If ToNode>MaxMudNodes
   Then Exit;

If T[0]=#00
   Then Exit;

Lock('Prv. Message');
If (NodeList[ToNode].Player>0) And (ToNode<>MyNode)
   Then Begin
        FileMode:=ReadWrite+ShareDenyAll;
        Assign(Out,TempDir+'Message.'+Nr2Str(ToNode));
        Reset(Out,1);
        If IoResult<>0
           Then Rewrite(Out,1);
        Seek(Out,FileSizE(Out));
        BlockWrite(Out,T,SizeOf(T),RW);
        Close(Out);
        If IoResult<>0
           Then;
        End;
Unlock;
End;


(*--------------------------------------------------------------------------*)
Procedure SayPrivate(ObjNr : Integer;S : String);
Var T : TextRecord;
Begin
FillChar(T,SizeOf(T),#00);
Move(S[1],T[0],Length(S));
PrivateMsg(ObjNr,T);
End;

(*--------------------------------------------------------------------------*)
Procedure SayToAllHere(Current : ContextType;S : String);
Var T : TextRecord;
Begin
FillChar(T,SizeOf(T),#00);
Move(S[1],T[0],Length(S));
NotifyAllHere(Current.PlayerName,T);
End;

Procedure SayToAll(S : String);
Var T : TextRecord;
Begin
FillChar(T,SizeOf(T),#00);
Move(S[1],T[0],Length(S));
NotifyAll(T);
End;


(*--------------------------------------------------------------------------*)
Procedure GeneralRemarkToAllHere(S : String);
Var T : TextRecord;
Begin
FillChar(T,SizeOf(T),#00);
Move(S[1],T[0],Length(S));
NotifyAllHere('',T);
End;



(*--------------------------------------------------------------------------*)
Function CheckMail:Boolean;
Var S : SearchRec;
Begin
FindFirst(TempDir+'MESSAGE.'+Nr2Str(MyNode),AnyFile,S);
CheckMail:=DosError=0;
End;

(*--------------------------------------------------------------------------*)
Procedure ResetPlayerObj(ObjNr : Integer);
Var Cnt : Integer;
    Tmp : File;
Begin
Cnt:=0;
While (Cnt<=MaxMudNodes) And (NodeList[Cnt].Player<>ObjNr) Do
 Inc(Cnt);

If Cnt>MaxMudNodes
   Then Exit;
Assign(Tmp,TempDir+'RESET.'+Nr2Str(Cnt));
Rewrite(Tmp,1);
Close(Tmp);
If IoResult<>0
   Then;
End;


(*--------------------------------------------------------------------------*)
Function CheckResetMe:Boolean;
Var S  : SearchRec;
    Tmp: File;
    Ok : Boolean;
Begin
FindFirst(TempDir+'RESET.'+Nr2Str(MyNode),AnyFile,S);
Ok:=DosError=0;
CheckResetMe:=Ok;
If Ok
   Then Begin
        Assign(Tmp,TempDir+'RESET.'+Nr2Str(MyNode));
        Erase(Tmp);
        if IoResult<>0
           Then;
        End;
End;

(*--------------------------------------------------------------------------*)
Function CheckShutDown:Boolean;
Var S : SearchRec;
Begin
FindFirst(TempDir+'SHUTDOWN.SEM',AnyFile,S);
CheckShutDown:=DosError=0;
End;

(*--------------------------------------------------------------------------*)
Procedure ShutDownGame;
Var Tmp : File;
Begin
Assign(Tmp,TempDir+'SHUTDOWN.SEM');
Rewrite(Tmp);
Close(Tmp);
If IoResult<>0 Then;
End;

(*--------------------------------------------------------------------------*)
Procedure ReadMail;
Var Inp : File of TextRecord;
    T   : TextRecord;
Begin
FileMode:=ReadOnly+ShareDenyNone;
Lock('Read mail');
Assign(Inp,TempDir+'MESSAGE.'+Nr2Str(MyNode));
Rename(Inp,TempDir+'HANDLED.'+Nr2Str(MyNode));
Unlock;

Reset(Inp);
While Not Eof(Inp) Do
 Begin
 Read(Inp,T);
 WriteText(T);
 End;
Close(Inp);
Erase(Inp);
If IoResult<>0
   Then Exit;
End;


(*--------------------------------------------------------------------------*)


Procedure Lock(Reason : String);
Var Ok      : Boolean;
    IOErr   : Integer;
    TimeOut : TimerObject;
Begin
Inc(LockCalls);
If LockLevel>0
   Then Begin
        Inc(LockLevel);
        Inc(DoubleCalls);
        Exit
        End
   Else LockLevel:=1;

FileMode:=ReadOnly+ShareDenyAll;
Assign(LockFile,TempDir+'MUDLOCK.SEM');
TimeOut.SetTimer(150);
Repeat
  Reset(LockFile,1);
  IOErr:=IoResult;
  Ok:=IoErr=0;
  If Not Ok
     Then Begin
          Inc(LockStats);
          {My_Beep;}
          My_Delay(300+Random(100));
          End;
Until OK or TimeOut.TimeUp;
If Not Ok
   Then begin
        My_WriteLn('ERROR: '+Reason);
        HALT(100);
        End;
End;

(*--------------------------------------------------------------------------*)
Procedure UnLock;
Var Regs    : Registers;
Begin
If LockLevel>1
   then Begin
        Dec(LockLevel);
        Exit;
        End
   Else LockLevel:=0;
Close(LockFile);
End;

Procedure ShowLockStat;
Begin
My_WriteLn('Current lock statistics:');
My_WriteLn('  LockLevel  : '+Nr2Str(LockLevel));
My_WriteLn('  LockStats  : '+Nr2Str(LockStats));
My_WriteLn('  LockCalls  : '+Nr2Str(LockCalls));
My_WriteLn('  DoubleCalls: '+Nr2Str(DoubleCalls));
End;



Begin
FillChar(NodeList,SizeOf(NodeList),#00);
MyNode:=0;
LockLevel:=0;
LockCalls:=0;
LockStats:=0;
DoubleCalls:=0;
End.